Figures and tables based on issue motive analyses (main)

Preparations

Load models

# pol models (across performance and neutral)
m1.pol <- readRDS(file = here(pol_model_dir, "m1.pol.rds"))
m2.pol <- readRDS(file = here(pol_model_dir, "m2.pol.rds"))
m3.pol <- readRDS(file = here(pol_model_dir, "m3.pol.rds"))
m4.pol <- readRDS(file = here(pol_model_dir, "m4.pol.rds"))
m5.pol <- readRDS(file = here(pol_model_dir, "m5.pol.rds"))
m6.pol <- readRDS(file = here(pol_model_dir, "m6.pol.rds"))

# performance models
m1.per <- readRDS(file = here(nonpol_model_dir, "m1.per.rds"))
m2.per <- readRDS(file = here(nonpol_model_dir, "m2.per.rds"))
m3.per <- readRDS(file = here(nonpol_model_dir, "m3.per.rds"))
m4.per <- readRDS(file = here(nonpol_model_dir, "m4.per.rds"))
m5.per <- readRDS(file = here(nonpol_model_dir, "m5.per.rds"))
m6.per <- readRDS(file = here(nonpol_model_dir, "m6.per.rds"))

# neutral models
m1.neu <- readRDS(file = here(nonpol_model_dir, "m1.neu.rds"))
m2.neu <- readRDS(file = here(nonpol_model_dir, "m2.neu.rds"))
m3.neu <- readRDS(file = here(nonpol_model_dir, "m3.neu.rds"))
m4.neu <- readRDS(file = here(nonpol_model_dir, "m4.neu.rds"))
m5.neu <- readRDS(file = here(nonpol_model_dir, "m5.neu.rds"))
m6.neu <- readRDS(file = here(nonpol_model_dir, "m6.neu.rds"))

Load original data

data_path <- here("01_data", "analysis", "data_analysis.RData")
load(file = data_path)

Filters

initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>% 
  filter(Screen != "Question")
filtered_rows <- initial_rows - nrow(data_prep)

filtered_rows
[1] 5389
data_full <- data_prep %>% 
  filter(question_type %in% c("political", "performance", "nonpolitical")) %>% 
  mutate(question_topic = factor(question_topic, 
                                 levels = c("climate",
                                            "gender",
                                            "immigration",
                                            "discrimination",
                                            "adoption",
                                            "punishment",
                                            "gonogo_performance", 
                                            "fakenews_performance",
                                            "teaculture",
                                            "brain"))) %>%
  droplevels()   

unique(data_full$question_topic)
 [1] adoption             climate              punishment           gender              
 [5] discrimination       gonogo_performance   immigration          teaculture          
 [9] fakenews_performance brain               
10 Levels: climate gender immigration discrimination adoption ... brain

Data types

data_full <- data_full %>%
  mutate(issue_motive_strength = factor(issue_motive_strength,
                                        levels = c("Anti-strong",
                                                   "Anti-moderate",
                                                   "Neutral",
                                                   "Pro-moderate",
                                                   "Pro-strong"),
                                        ordered = TRUE)) 

Data for submodels

data_pol <- data_full %>% 
  filter(question_type == "political") %>% 
  droplevels() 

data_per <- data_full %>% 
  filter(question_type == "performance") %>% 
  droplevels()   

data_neu <- data_full %>% 
  filter(question_type == "nonpolitical") %>% 
  droplevels()  

unique(data_pol$question_topic)
[1] adoption       climate        punishment     gender         discrimination
[6] immigration   
Levels: climate gender immigration discrimination adoption punishment
unique(data_per$question_topic)
[1] gonogo_performance   fakenews_performance
Levels: gonogo_performance fakenews_performance
unique(data_neu$question_topic)
[1] teaculture brain     
Levels: teaculture brain

Table 1: Parameter estimates of interest m1, m3, m4 (logit)

Create a logit table with main parameters of interest of m1, m3, m4.

m1 table

h0a.pol <- hypothesis(m1.pol, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.per <- hypothesis(m1.per, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.neu <- hypothesis(m1.neu, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.pol$hypothesis$Evid.Ratio
[1] Inf
h0a.per$hypothesis$Evid.Ratio
[1] 91
h0a.neu$hypothesis$Evid.Ratio
[1] Inf
h0b.pol <- hypothesis(m1.pol, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.per <- hypothesis(m1.per, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.neu <- hypothesis(m1.neu, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.pol$hypothesis$Evid.Ratio
[1] 0
h0b.per$hypothesis$Evid.Ratio
[1] 0.011
h0b.neu$hypothesis$Evid.Ratio
[1] 0
m1.pol.logit <- describe_posterior(m1.pol, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h0a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h0b.pol$hypothesis$Evid.Ratio)

m1.per.logit <- describe_posterior(m1.per, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h0a.per$hypothesis$Evid.Ratio,
         "β < 0" = h0b.per$hypothesis$Evid.Ratio)

m1.neu.logit <- describe_posterior(m1.neu, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h0a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h0b.neu$hypothesis$Evid.Ratio)

m1.logit <- bind_rows(m1.pol.logit, m1.per.logit, m1.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro") %>% 
  mutate(Parameter = "Motive (Pro > Anti)") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m1.logit
Summary of Posterior Distribution

Question Type |           Parameter | Median |   LL |   UL | β > 0 | β < 0
--------------------------------------------------------------------------
Political     | Motive (Pro > Anti) |   0.36 | 0.26 | 0.47 |   Inf |  0.00
Performance   | Motive (Pro > Anti) |   0.17 | 0.03 | 0.31 | 90.95 |  0.01
Neutral       | Motive (Pro > Anti) |   0.36 | 0.21 | 0.52 |   Inf |  0.00

m3 table

h1a.pol <- hypothesis(m3.pol, "issue_motivePro:scalecrt_correct > 0",
                                alpha = 0.025,
                                seed = 42)

h1a.per <- hypothesis(m3.per, "issue_motivePro:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a.neu <- hypothesis(m3.neu, "issue_motivePro:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a.pol$hypothesis$Evid.Ratio
[1] 0.0492
h1a.per$hypothesis$Evid.Ratio
[1] 0.499
h1a.neu$hypothesis$Evid.Ratio
[1] 0.13
h1b.pol <- hypothesis(m3.pol, "issue_motivePro:scalecrt_correct < 0",
                      alpha = 0.025,
                      seed = 42)

h1b.per <- hypothesis(m3.per, "issue_motivePro:scalecrt_correct < 0", 
                      alpha = 0.025,
                      seed = 42)

h1b.neu <- hypothesis(m3.neu, "issue_motivePro:scalecrt_correct < 0", 
                      alpha = 0.025,
                      seed = 42)

h1b.pol$hypothesis$Evid.Ratio
[1] 20.3
h1b.per$hypothesis$Evid.Ratio
[1] 2.01
h1b.neu$hypothesis$Evid.Ratio
[1] 7.7
m3.pol.logit <- describe_posterior(m3.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h1a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h1b.pol$hypothesis$Evid.Ratio)

m3.per.logit <- describe_posterior(m3.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h1a.per$hypothesis$Evid.Ratio,
         "β < 0" = h1b.per$hypothesis$Evid.Ratio)

m3.neu.logit <- describe_posterior(m3.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h1a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h1b.neu$hypothesis$Evid.Ratio)

m3.logit <- bind_rows(m3.pol.logit, m3.per.logit, m3.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro:scalecrt_correct") %>% 
  mutate(Parameter = "Motive x Cognitive Reflection") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m3.logit
Summary of Posterior Distribution

Question Type |                     Parameter | Median |    LL |   UL | β > 0 | β < 0
-------------------------------------------------------------------------------------
Political     | Motive x Cognitive Reflection |  -0.06 | -0.14 | 0.01 |  0.05 | 20.33
Performance   | Motive x Cognitive Reflection |  -0.03 | -0.18 | 0.12 |  0.50 |  2.00
Neutral       | Motive x Cognitive Reflection |  -0.10 | -0.26 | 0.06 |  0.13 |  7.70

m4 table

h2a.pol <- hypothesis(m4.pol, "issue_motivePro:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a.per <- hypothesis(m4.per, "issue_motivePro:scalecommission_errors_r > 0", 
                      alpha = 0.025,
                      seed = 42)

h2a.neu <- hypothesis(m4.neu, "issue_motivePro:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a.pol$hypothesis$Evid.Ratio
[1] 2.71
h2a.per$hypothesis$Evid.Ratio
[1] 0.191
h2a.neu$hypothesis$Evid.Ratio
[1] 63
h2b.pol <- hypothesis(m4.pol, "issue_motivePro:scalecommission_errors_r < 0",
                      alpha = 0.025,
                      seed = 42)

h2b.per <- hypothesis(m4.per, "issue_motivePro:scalecommission_errors_r < 0", 
                      alpha = 0.025,
                      seed = 42)

h2b.neu <- hypothesis(m4.neu, "issue_motivePro:scalecommission_errors_r < 0",
                      alpha = 0.025,
                      seed = 42)

h2b.pol$hypothesis$Evid.Ratio
[1] 0.368
h2b.per$hypothesis$Evid.Ratio
[1] 5.25
h2b.neu$hypothesis$Evid.Ratio
[1] 0.0159
m4.pol.logit <- describe_posterior(m4.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h2a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h2b.pol$hypothesis$Evid.Ratio)

m4.per.logit <- describe_posterior(m4.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h2a.per$hypothesis$Evid.Ratio,
         "β < 0" = h2b.per$hypothesis$Evid.Ratio)

m4.neu.logit <- describe_posterior(m4.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h2a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h2b.neu$hypothesis$Evid.Ratio)

m4.logit <- bind_rows(m4.pol.logit, m4.per.logit, m4.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro:scalecommission_errors_r") %>% 
  mutate(Parameter = "Motive x Inhibitory Control") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m4.logit
Summary of Posterior Distribution

Question Type |                   Parameter | Median |    LL |   UL | β > 0 | β < 0
-----------------------------------------------------------------------------------
Political     | Motive x Inhibitory Control |   0.02 | -0.05 | 0.10 |  2.71 |  0.37
Performance   | Motive x Inhibitory Control |  -0.07 | -0.23 | 0.07 |  0.19 |  5.25
Neutral       | Motive x Inhibitory Control |   0.17 |  0.01 | 0.33 | 63.00 |  0.02

Combined table

combined_logit <- bind_rows(m1.logit, m3.logit, m4.logit) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) %>% 
  arrange(`Question Type`, Parameter)

combined_logit_table <- combined_logit %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 4,
      "Neutral Vignettes" = 7
    ),
    j = list(
      "95% CI" = 3:4,
      "Evidence Ratio" = 5:6))

combined_logit_table %>% save_tt(here(table_dir, "combined_logit_table.docx"), overwrite = TRUE)

combined_logit_table
tinytable_lu5jexmbp01nxordx1uv
95% CI Evidence Ratio
Parameter Median LL UL β > 0 β < 0
Motive (Pro > Anti) 0.363 0.258 0.475 Inf 0.000
Motive x Cognitive Reflection -0.063 -0.139 0.010 0.049 20.333
Motive x Inhibitory Control 0.024 -0.049 0.100 2.714 0.368
Motive (Pro > Anti) 0.169 0.025 0.312 90.954 0.011
Motive x Cognitive Reflection -0.033 -0.180 0.116 0.499 2.005
Motive x Inhibitory Control -0.075 -0.232 0.075 0.191 5.245
Motive (Pro > Anti) 0.361 0.209 0.517 Inf 0.000
Motive x Cognitive Reflection -0.097 -0.261 0.060 0.130 7.696
Motive x Inhibitory Control 0.173 0.012 0.329 63.000 0.016

Main Text: Reported Percentage Predictions m1, m3

m1: Pro vs. Anti in %

Calculate % comparisons

m1.pol.com <- m1.pol %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Political") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")
m1.per.com <- m1.per %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Performance") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")
m1.neu.com <- m1.neu %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Neutral") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")

Combined table

m1.combined_perc <- bind_rows(m1.pol.com, m1.per.com, m1.neu.com) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) 

m1.combined_perc_table <- m1.combined_perc %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 2,
      "Neutral Vignettes" = 3
    ),
    j = list(
      "95% CI" = 3:4))

m1.combined_perc_table %>% save_tt(here(table_dir, "m1_combined_perc_table.docx"), overwrite = TRUE)

m1.combined_perc_table
tinytable_aacxedprhgxbtyjpo7jr
95% CI
Contrast Estimate LL UL
Pro - Anti 0.0923 0.0741 0.1105
Pro - Anti 0.0419 0.0079 0.0757
Pro - Anti 0.0944 0.0571 0.1322

m3: Pro vs. Anti for CRT = 3 and CRT = 0 in %

crt.newdata <- 
  expand_grid(issue_motive = c("Pro", "Anti"),
              crt_correct = c(0, 3))
m3.pol.com <- m3.pol %>%
    epred_draws(newdata = crt.newdata,
                re_formula = NA) %>% 
    group_by(crt_correct) %>% 
    compare_levels(.epred, by = issue_motive) %>% 
    compare_levels(.epred, by = crt_correct) %>% 
    median_qi(.width = 0.95)
m3.pol.com %>% tt()
tinytable_8lq7i6pf7mkfusq9jhf7
crt_correct issue_motive .epred .lower .upper .width .point .interval
3 - 0 Pro - Anti -0.0418 -0.0922 0.00625 0.95 median qi

Figure: Motivated Reasoning on Different Topics

Extract draws

Average effect of motivated reasoning on political, performance, and neutral topics

m1.pol.draws <- m1.pol %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Political",
         question_topic = "average")

m1.pol.draws %>% median_hdi(draw)
# A tibble: 1 × 6
    draw .lower .upper .width .point .interval
   <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0923 0.0746  0.111   0.95 median hdi      
m1.per.draws <- m1.per %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Performance",
         question_topic = "average")

m1.per.draws %>% median_hdi(draw)
# A tibble: 1 × 6
    draw  .lower .upper .width .point .interval
   <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0419 0.00833 0.0760   0.95 median hdi      
m1.neu.draws <- m1.neu %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Neutral",
         question_topic = "average")

m1.neu.draws %>% median_hdi(draw)
# A tibble: 1 × 6
    draw .lower .upper .width .point .interval
   <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0944 0.0568  0.132   0.95 median hdi      

Motivated reasoning by topic

m1.pol.topic <- avg_comparisons(m1.pol,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Political")
  
m1.pol.topic %>% group_by(question_topic) %>% median_hdi(draw)
# A tibble: 6 × 7
  question_topic   draw .lower .upper .width .point .interval
  <fct>           <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 climate        0.0986 0.0715  0.129   0.95 median hdi      
2 gender         0.0918 0.0644  0.119   0.95 median hdi      
3 immigration    0.0933 0.0647  0.123   0.95 median hdi      
4 discrimination 0.0987 0.0706  0.131   0.95 median hdi      
5 adoption       0.0917 0.0644  0.122   0.95 median hdi      
6 punishment     0.0798 0.0424  0.110   0.95 median hdi      
m1.per.topic <- avg_comparisons(m1.per,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Performance")
  
m1.per.topic %>% group_by(question_topic) %>% median_hdi(draw)
# A tibble: 2 × 7
  question_topic         draw   .lower .upper .width .point .interval
  <fct>                 <dbl>    <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 gonogo_performance   0.0398 -0.0108  0.0840   0.95 median hdi      
2 fakenews_performance 0.0440 -0.00235 0.0955   0.95 median hdi      
m1.neu.topic <- avg_comparisons(m1.neu,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Neutral")
  
m1.neu.topic %>% group_by(question_topic) %>% median_hdi(draw)
# A tibble: 2 × 7
  question_topic   draw  .lower .upper .width .point .interval
  <fct>           <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 teaculture     0.137   0.0866  0.187   0.95 median hdi      
2 brain          0.0442 -0.0121  0.101   0.95 median hdi      

Create a combined dataframe

m1.combined <- bind_rows(m1.pol.draws, m1.pol.topic, 
                         m1.per.draws, m1.per.topic,
                         m1.neu.draws, m1.neu.topic)
m1.combined <- m1.combined %>% 
  mutate(question_topic = factor(question_topic,
                                 levels = c("brain",
                                            "teaculture", 
                                            "fakenews_performance", 
                                            "gonogo_performance",
                                            "punishment",
                                            "adoption", 
                                            "discrimination",
                                            "gender",
                                            "immigration",
                                            "climate", 
                                            "average"),
                                 labels = c("Brain proportion",
                                            "Tea with milk",
                                            "Fake News performance",
                                            "Go / No-Go performance",
                                            "Criminal reconviction",
                                            "Same-sex adoption",
                                            "Racial discrimination",
                                            "Gender stereotypes",
                                            "Immigrant population",
                                            "Anthropogenic climate change",
                                            "Average"
                                            )),
         draw_perc = draw*100) 

Create figure

average_color <- "#645CAA"

plot_political <- m1.combined %>%
  filter(question_type == "Political") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#A685E2")) +
  labs(subtitle = "Political Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25),
                     breaks = seq(-10, 20, by = 5)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

plot_performance <- m1.combined %>%
  filter(question_type == "Performance") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#FF8DC7")) +
  labs(subtitle = "Performance Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

plot_neutral <- m1.combined %>%
  filter(question_type == "Neutral") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#FFABE1")) +
  labs(subtitle = "Neutral Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

main_effect_plot <- plot_political / (plot_performance | plot_neutral) +
  plot_layout(heights = c(2, 1))

main_effect_plot

ggsave(here(fig_dir, "m1_main_fig.png"), width = 12, height = 10, dpi = 300)

Supplementary Table 3

Create a logit table with main parameters of interest of m2, m5, m6.

m2 table

h0a_mo.pol <- as_tibble(m2.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)


h0a_mo.per <- as_tibble(m2.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)

h0a_mo.neu <- as_tibble(m2.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)

h0a_mo.pol$hypothesis$Evid.Ratio
[1] Inf
h0a_mo.per$hypothesis$Evid.Ratio
[1] 399
h0a_mo.neu$hypothesis$Evid.Ratio
[1] Inf
h0b_mo.pol <- as_tibble(m2.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)


h0b_mo.per <- as_tibble(m2.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)

h0b_mo.neu <- as_tibble(m2.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)

h0b_mo.pol$hypothesis$Evid.Ratio
[1] 0
h0b_mo.per$hypothesis$Evid.Ratio
[1] 0.00251
h0b_mo.neu$hypothesis$Evid.Ratio
[1] 0
m2.pol.logit <- describe_posterior(m2.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h0a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.pol$hypothesis$Evid.Ratio)

m2.per.logit <- describe_posterior(m2.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h0a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.per$hypothesis$Evid.Ratio)

m2.neu.logit <- describe_posterior(m2.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h0a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.neu$hypothesis$Evid.Ratio)

m2.logit <- bind_rows(m2.pol.logit, m2.per.logit, m2.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength") %>% 
  mutate(Parameter = "Motive strength") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m2.logit
Summary of Posterior Distribution

Question Type |       Parameter | Median |   LL |   UL |  β > 0 |    β < 0
--------------------------------------------------------------------------
Political     | Motive strength |   0.12 | 0.09 | 0.15 |    Inf |     0.00
Performance   | Motive strength |   0.12 | 0.03 | 0.22 | 399.00 | 3.00e-03
Neutral       | Motive strength |   0.13 | 0.07 | 0.19 |    Inf |     0.00

m5 table

h1a_mo.pol <- as_tibble(m5.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0",
                      alpha = 0.025,
                      seed = 42)

h1a_mo.per <- as_tibble(m5.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a_mo.neu <- as_tibble(m5.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a_mo.pol$hypothesis$Evid.Ratio
[1] 0.0382
h1a_mo.per$hypothesis$Evid.Ratio
[1] 0.315
h1a_mo.neu$hypothesis$Evid.Ratio
[1] 0.321
h1b_mo.pol <- as_tibble(m5.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0",
             alpha = 0.025,
             seed = 42)

h1b_mo.per <- as_tibble(m5.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0", 
             alpha = 0.025,
             seed = 42)

h1b_mo.neu <- as_tibble(m5.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0", 
             alpha = 0.025,
             seed = 42)

h1b_mo.pol$hypothesis$Evid.Ratio
[1] 26.2
h1b_mo.per$hypothesis$Evid.Ratio
[1] 3.18
h1b_mo.neu$hypothesis$Evid.Ratio
[1] 3.12
m5.pol.logit <- describe_posterior(m5.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h1a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.pol$hypothesis$Evid.Ratio)

m5.per.logit <- describe_posterior(m5.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h1a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.per$hypothesis$Evid.Ratio)

m5.neu.logit <- describe_posterior(m5.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h1a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.neu$hypothesis$Evid.Ratio)

m5.logit <- bind_rows(m5.pol.logit, m5.per.logit, m5.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength:scalecrt_correct") %>% 
  mutate(Parameter = "Motive strength x Cognitive Reflection") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m5.logit
Summary of Posterior Distribution

Question Type |                              Parameter | Median |    LL |       UL | β > 0 | β < 0
--------------------------------------------------------------------------------------------------
Political     | Motive strength x Cognitive Reflection |  -0.02 | -0.05 | 2.00e-03 |  0.04 | 26.21
Performance   | Motive strength x Cognitive Reflection |  -0.02 | -0.10 |     0.04 |  0.32 |  3.17
Neutral       | Motive strength x Cognitive Reflection |  -0.02 | -0.07 |     0.04 |  0.32 |  3.12

m6 table

h2a_mo.pol <- as_tibble(m6.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a_mo.per <- as_tibble(m6.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0", 
                      alpha = 0.025,
                      seed = 42)

h2a_mo.neu <- as_tibble(m6.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a_mo.pol$hypothesis$Evid.Ratio
[1] 3.55
h2a_mo.per$hypothesis$Evid.Ratio
[1] 0.429
h2a_mo.neu$hypothesis$Evid.Ratio
[1] 95.4
h2b_mo.pol <- as_tibble(m6.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0",
             alpha = 0.025,
             seed = 42)

h2b_mo.per <- as_tibble(m6.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0", 
             alpha = 0.025,
             seed = 42)

h2b_mo.neu <- as_tibble(m6.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0",
             alpha = 0.025,
             seed = 42)

h2b_mo.pol$hypothesis$Evid.Ratio
[1] 0.282
h2b_mo.per$hypothesis$Evid.Ratio
[1] 2.33
h2b_mo.neu$hypothesis$Evid.Ratio
[1] 0.0105
m6.pol.logit <- describe_posterior(m6.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h2a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h2b_mo.pol$hypothesis$Evid.Ratio)

m6.per.logit <- describe_posterior(m6.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h2a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h2b_mo.per$hypothesis$Evid.Ratio)

m6.neu.logit <- describe_posterior(m6.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h2a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h2a_mo.neu$hypothesis$Evid.Ratio)

m6.logit <- bind_rows(m6.pol.logit, m6.per.logit, m6.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength:scalecommission_errors_r") %>% 
  mutate(Parameter = "Motive strength x Inhibitory Control") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m6.logit
Summary of Posterior Distribution

Question Type |                            Parameter |   Median |    LL |   UL | β > 0 | β < 0
----------------------------------------------------------------------------------------------
Political     | Motive strength x Inhibitory Control | 9.00e-03 | -0.01 | 0.03 |  3.55 |  0.28
Performance   | Motive strength x Inhibitory Control |    -0.02 | -0.08 | 0.06 |  0.43 |  2.33
Neutral       | Motive strength x Inhibitory Control |     0.06 |  0.01 | 0.12 | 95.39 | 95.39

Combined table

combined_mo_logit <- bind_rows(m2.logit, m5.logit, m6.logit) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) %>% 
  arrange(`Question Type`, Parameter)

combined_mo_logit_table <- combined_mo_logit %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 4,
      "Neutral Vignettes" = 7
    ),
    j = list(
      "95% CI" = 3:4,
      "Evidence Ratio" = 5:6))

combined_mo_logit_table %>% save_tt(here(table_dir, "combined_mo_logit_table.docx"), overwrite = TRUE)

combined_mo_logit_table
tinytable_l2faes0hv47j9hggs0di
95% CI Evidence Ratio
Parameter Median LL UL β > 0 β < 0
Motive strength 0.118 0.085 0.151 Inf 0.000
Motive strength x Cognitive Reflection -0.022 -0.048 0.002 0.038 26.211
Motive strength x Inhibitory Control 0.009 -0.015 0.034 3.548 0.282
Motive strength 0.123 0.030 0.224 399.000 0.003
Motive strength x Cognitive Reflection -0.022 -0.102 0.039 0.315 3.175
Motive strength x Inhibitory Control -0.017 -0.079 0.062 0.429 2.331
Motive strength 0.126 0.072 0.190 Inf 0.000
Motive strength x Cognitive Reflection -0.019 -0.074 0.038 0.321 3.119
Motive strength x Inhibitory Control 0.063 0.010 0.122 95.386 95.386

Supplementary Figure 2

Extract draws

m2.pol.draws <- m2.pol %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                                    question_topic = levels(data_pol$question_topic)),
              re_formula = ~(issue_motive|question_topic)) 

m2.per.draws <- m2.per %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                               question_topic = levels(data_per$question_topic)),
              re_formula = NA) 


m2.neu.draws <- m2.neu %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                               question_topic = levels(data_neu$question_topic)),
              re_formula = NA) 
m2.draws <- bind_rows(m2.pol.draws, m2.per.draws, m2.neu.draws) %>% 
  mutate(issue_motive_strength = factor(issue_motive_strength,
                                        levels = c("Anti-strong",
                                                   "Anti-moderate",
                                                   "Neutral", 
                                                   "Pro-moderate",
                                                   "Pro-strong"),
                                        ordered = TRUE),
         question_topic = factor(question_topic, 
                        levels = c("climate",
                                   "immigration",
                                   "gender",
                                   "discrimination",
                                   "adoption",
                                   "punishment",
                                   "gonogo_performance",
                                   "fakenews_performance",
                                   "teaculture",
                                   "brain"),
                        labels = c("Anthropogenic climate change",
                                   "Immigrant population",
                                   "Gender stereotypes",
                                   "Racial discrimination",
                                   "Same-sex adoption",
                                   "Criminal reconviction",
                                   "Go / No-Go performance",
                                   "Fake News performance",
                                   "Tea with milk",
                                   "Brain proportion")))

Create figure

m2.draws %>% 
  mutate(perc = .epred * 100) %>% 
  ggplot(aes(x = perc, y = issue_motive_strength, fill = issue_motive_strength)) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 50, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  guides(fill = "none") +
  scale_fill_manual(values = rev(beyonce_palette(41, n = 5, 
                                             type = "continuous"))) +
  labs(title="Message Ratings by Motive Strength",
       x = "Coefficients", y = NULL,
       caption = "50% and 95% credible intervals shown in black") +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(25, 75),
                     breaks = seq(30, 70, by = 10)) +
  theme_ipsum_rc(base_size = 12,
                 plot_title_size = 14,
                 axis_title_size = 12,
                 axis_title_face = "bold",
                 axis_text_size = 12,
                 strip_text_size = 12,
                 strip_text_face = "bold"
                 ) + 
  facet_wrap(~question_topic, ncol = 2)

ggsave(here(fig_dir, "m2_perc_fig.png"), width = 8, height = 12, dpi = 300)